home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Containrs / sa / orig_fset < prev    next >
Text File  |  1996-06-01  |  14KB  |  409 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  3. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  4. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  5. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  6. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  7. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  8.  
  9. -- fset.sa: Hash-based sets of objects of type T.
  10. -------------------------------------------------------------------
  11. class ORIG_FSET{T}  is
  12.    --  Original version of the FSET class. Use FSET instead
  13.    -- Hash array based sets of objects of type T requiring writebacks.
  14.    -- 
  15.    -- If T is a subtype of $NIL, then `nil' may not be an element,
  16.    -- otherwise the type's default value may not be a element.
  17.    -- 
  18.    -- If T is a subtype of $IS_EQ, then `is_eq' will be used for
  19.    -- element equality (eg. string equality for STR), otherwise 
  20.    -- object equality is used. 
  21.    -- 
  22.    -- If T is a subtype of $HASH, then `hash' will be used for the hash
  23.    -- value, otherwise the element `id' will be used.
  24.    -- 
  25.    -- May be inherited with `elt_eq', `elt_nil', and `elt_hash' redefined
  26.    -- to get a different behavior.
  27.    --
  28.    -- The tables grow by amortized doubling and so require writeback
  29.    -- when inserting and deleting elements.  We keep down the load
  30.    -- factor to cut down on collision snowballing.  The simple
  31.    -- collision resolution allows us to support deletions, but makes
  32.    -- the behavior with poor hash functions quadratic.  Puts a
  33.    -- sentinel at the end of the table to avoid one check while
  34.    -- searching.
  35.    include COMPARE{T};
  36.    include AREF{T};
  37.     
  38.    private attr hsize:INT;    -- Number of stored entries.
  39.  
  40.    private const load_ratio:INT:=4; -- Allow to be at most 1/load_ratio full
  41.     
  42.    -- We can't have an invariant here, because sometimes we want
  43.    -- to be able to destroy 'self' for efficiency.
  44.  
  45.    --invariant:BOOL is        
  46.    --    -- Class invariant.
  47.    --    return void(self) or hsize.is_bet(0,asize) end;
  48.     
  49.    create:SAME is return void end;
  50.     
  51.    create(n:INT):SAME 
  52.    -- Make a table capable of dealing with `n' elements without
  53.    -- expansion. You can simply insert into a void table to create 
  54.    -- one as well. Self may be void (and often is).
  55.       pre n>=1 is 
  56.       return allocate(1.lshift((3*load_ratio*n/4).highest_bit+1)+1) 
  57.    end;
  58.  
  59.    create(arr: ARRAY{T}): SAME is return create_from(arr) end;
  60.    
  61.    create_from(a: $CONTAINER{T}): SAME is
  62.       res: SAME := #(a.size);
  63.       loop res := res.insert(a.elt!) end;
  64.       return res;
  65.    end;
  66.    
  67.    private allocate(n:INT):SAME is
  68.       -- Allocate `n' locations (must be power of 2 plus 1) and
  69.       -- initialize to `elt_nil'.
  70.       r::=new(n); 
  71.       if ~void(elt_nil) then loop r.aset!(elt_nil) end end;
  72.       return r end;
  73.     
  74.    size:INT is
  75.       -- Number of entries in the table. Self may be void.
  76.       if void(self) then return 0 else return hsize end end;
  77.  
  78.    copy:SAME is
  79.       -- A copy of self.
  80.       r:SAME; loop r:=r.insert(elt!) end; return r end;
  81.     
  82.    elt!:T is
  83.       -- Yield the elements in self in an arbitrary order. Do not insert
  84.       -- or delete from self while calling this. Self may be void.
  85.       if ~void(self) then 
  86.      loop r::=aelt!; 
  87.         if ~is_elt_nil(r) then yield r end end end end;
  88.  
  89.    first_elt:T is
  90.       -- The first element in the table, if any, otherwise elt_nil.
  91.       if ~void(self) then 
  92.      loop r::=aelt!; 
  93.         if ~is_elt_nil(r) then return r end end end;
  94.       return elt_nil end;
  95.     
  96.    has(e: T): BOOL is return test(e) end;
  97.    
  98.    
  99.    test(e:T):BOOL is
  100.       -- True if `e' is `elt_eq' to an element contained in self. 
  101.       -- Self may be void.
  102.       if void(self) then return false end;  
  103.       h::=elt_hash(e).band(asize-2);
  104.       loop te::=[h];  
  105.      if is_elt_nil(te) then break!
  106.      elsif elt_eq(te,e) then return true
  107.      end;  
  108.      h:=h+1 end;
  109.       if h=asize-1 then        -- hit sentinel
  110.      h:=0;
  111.      loop te::=[h];
  112.         if is_elt_nil(te) then break!
  113.         elsif elt_eq(te,e) then return true
  114.         end;  
  115.         h:=h+1 end;
  116.      assert h/=asize-1 end; -- table mustn't be filled
  117.       return false end;
  118.     
  119.    get(e:T):T is
  120.       -- If `e' is `elt_eq' to a table entry, return that entry, 
  121.       -- otherwise return `elt_nil'. Useful when different objects 
  122.       -- are treated as equal (eg. a table of strings used to get a 
  123.       -- unique representative for each class of equal strings).
  124.       -- Self may be void.
  125.       if void(self) then return elt_nil end;
  126.       h::=elt_hash(e).band(asize-2);    
  127.       loop te::=[h];
  128.      if is_elt_nil(te) then break!
  129.      elsif elt_eq(te,e) then return te
  130.      end;
  131.      h:=h+1 end;
  132.       if h=asize-1 then h:=0;    -- hit sentinel
  133.      loop te::=[h];
  134.         if is_elt_nil(te) then break!
  135.         elsif elt_eq(te,e) then return te
  136.         end;
  137.         h:=h+1 end;
  138.      assert h/=asize-1 end; -- table mustn't be filled
  139.       return elt_nil end;
  140.     
  141.    private double_size:SAME 
  142.    -- A new table of twice the size of self with self's entries
  143.    -- copied over. 
  144.       pre ~void(self) is
  145.       r::=allocate((asize-1)*2+1); 
  146.       loop r:=r.insert(elt!) end;
  147.       SYS::destroy(self);    -- The old set should never be used now.
  148.       return r end;
  149.  
  150.    private should_grow:BOOL is
  151.       return (hsize+1)*load_ratio>asize;
  152.    end;
  153.     
  154.    insert(e:T):SAME is
  155.       -- A possibly new table which includes `e'. If an entry 
  156.       -- is `elt_eq' to `e' then overwrite it with `e'.
  157.       -- Usage: `tbl:=tbl.insert(e)'. 
  158.       -- Creates a new table if void(self).
  159.       r::=self;
  160.       if void(r) then r:=allocate(5)
  161.       elsif should_grow then r:=double_size end;
  162.       asz::=r.asize;
  163.       orig_h::=r.elt_hash(e).band(asz-2);
  164.       h::=orig_h;
  165.       loop te::=r[h];
  166.      if is_elt_nil(te) then break!
  167.      elsif elt_eq(te,e) then r[h]:=e; return r end;
  168.      h:=h+1 end;
  169.       if h=asz-1 then h:=0;    -- hit sentinel
  170.      loop te::=r[h];
  171.         if is_elt_nil(te) then break!
  172.         elsif elt_eq(te,e) then r[h]:=e; return r end;
  173.         h:=h+1 end;
  174.      assert h/=asz-1 end; -- table mustn't be filled    
  175.       assert not_too_many(orig_h,h); -- Look for excessive collisions
  176.       r[h]:=e; r.hsize:=r.hsize+1; return r end;
  177.  
  178.    private not_too_many(start, finish:INT):BOOL is
  179.       -- A function called in an assert to check that really
  180.       -- bad hashing isn't happening, which would probably
  181.       -- be a performance bug.  Since it is in an assert, this
  182.       -- isn't called unless checking is on.
  183.       if finish>start+50 then
  184.      #ERR+"Found a problem: excessive collisions in "
  185.            +SYS::str_for_tp(SYS::tp(self))
  186.            +", probably\n"
  187.            +"due to a bad hash function in the class "
  188.            +SYS::str_for_tp(SYS::tp([start]))
  189.            +".\n";
  190.      t:T;
  191.      typecase t
  192.      when $STR then
  193.         #OUT + "Snowballing values:\n";
  194.         loop
  195.            i::=start.upto!(finish-1);
  196.            e::=[i];
  197.            h::=elt_hash(e);
  198.            typecase e
  199.            when $STR then
  200.           #OUT + i 
  201.             + '\t' + h.hex_str 
  202.             + '\t' + h.band(asize-2) 
  203.             + '\t' + e.str.pretty + '\n';
  204.            end;
  205.         end;
  206.      else
  207.      end;
  208.      return false;
  209.       end;
  210.       return true;
  211.    end;
  212.     
  213.    private halve_size:SAME 
  214.    -- A new table of half the size of self with self's entries
  215.    -- copied over. 
  216.       pre ~void(self) and hsize<(asize-1)/4 is
  217.       r::=allocate((asize-1)/2+1);
  218.       loop r:=r.insert(elt!) end;
  219.       SYS::destroy(self);    -- The old set should never be used now.
  220.       return r end;
  221.  
  222.    private should_shrink:BOOL is
  223.       return asize>=33 and hsize<(asize-1)/(load_ratio*2);
  224.    end;
  225.     
  226.    delete(e:T):SAME is
  227.       -- A possibly new table which deletes the element `e' if it
  228.       -- is contained in self. Doesn't modify the table if arg 
  229.       -- is not contained. Usage: `tbl:=tbl.delete(e)'.
  230.       -- Self may be void.
  231.       if void(self) then return void end;
  232.       h::=elt_hash(e).band(asize-2);
  233.       loop te::=[h];
  234.      if is_elt_nil(te) then return self
  235.      elsif elt_eq(te,e) then break! end;
  236.      if h=asize-2 then h:=0 else h:=h+1 end end;
  237.       [h]:=elt_nil; hsize:=hsize-1; i::=h; -- h is the index of arg
  238.       -- Now check the block after h for collisions.
  239.       loop 
  240.      if i=asize-2 then i:=0 else i:=i+1 end;
  241.      te::=[i];
  242.      if is_elt_nil(te) then break! end;
  243.      hsh::=elt_hash(te).band(asize-2);
  244.      if hsh<=i then        -- block doesn't wrap around
  245.         if h<i and h>=hsh then -- hole in way
  246.            [h]:=[i]; h:=i; [i]:=elt_nil end
  247.      else            -- block wraps
  248.         if h>=hsh or h<i then -- hole in way
  249.            [h]:=[i]; h:=i; [i]:=elt_nil end end end;
  250.       if should_shrink then return halve_size
  251.       else return self end end;
  252.  
  253.    clear:SAME is
  254.       -- Clear out self, return the space if it has 17 or less entries
  255.       -- otherwise return void. Self may be void.
  256.       if void(self) then return void end;
  257.       if asize<=17 then r::=self; r.hsize:=0;
  258.      loop r.aset!(elt_nil) end; return r
  259.       else return void end end;
  260.  
  261.    is_empty:BOOL is        
  262.       -- True if the set is empty. Self may be void.
  263.       return (void(self)) or (hsize=0) end;
  264.     
  265.    equals(s:$RO_SET{T}):BOOL is    
  266.       -- True if `s' has the same elements as self. Self may be void.
  267.       loop if ~s.has(elt!) then return false end end;
  268.       loop if ~has(s.elt!) then return false end end;
  269.       return true 
  270.    end;
  271.     
  272.    is_disjoint_from(s:SAME):BOOL is
  273.       -- True if self and `s' have no elements in common.
  274.       -- Self may be void.
  275.       loop if s.test(elt!) then return false end end;
  276.       return true end;
  277.     
  278.    intersects(s:SAME):BOOL is
  279.       -- True if self and `s' have elements in common.
  280.       -- Self may be void.
  281.       return ~is_disjoint_from(s) end;
  282.     
  283.    is_subset(s:SAME):BOOL is
  284.       -- True if all elements of self are contained in `s'.
  285.       -- Self may be void.
  286.       loop if ~s.test(elt!) then return false end end;
  287.       return true end;
  288.     
  289.    to_union(s:SAME):SAME is
  290.       -- The union of self and `s', modifies self.
  291.       -- Self may be void.
  292.       r::=self; loop r:=r.insert(s.elt!) end; return r end;
  293.     
  294.    to_intersect(s:SAME):SAME is
  295.       -- The intersection of self and `s', modifies self.
  296.       -- Self may be void.  Can't think of a way to do this
  297.       -- in place.
  298.       return intersect(s) end;
  299.     
  300.    intersect(s:SAME):SAME is
  301.       -- A new set which is the intersection of self and s.
  302.       -- Self may be void.
  303.       r:SAME;
  304.       loop e::=elt!;
  305.      if s.test(e) then r:=r.insert(e) end end; return r end;
  306.     
  307.    to_difference(s:SAME):SAME is
  308.       -- The difference of self and `s', modifies self.
  309.       -- Self may be void.
  310.       r::=self; loop r:=r.delete(s.elt!) end; return r end;
  311.     
  312.    difference(s:SAME):SAME is
  313.       -- A new set which is the difference between self and `s'.
  314.       -- Self may be void.
  315.       r:SAME;
  316.       loop e::=elt!;
  317.      if ~s.test(e) then r:=r.insert(e) end end; 
  318.       return r end;
  319.     
  320.    to_sym_difference(s:SAME):SAME is
  321.       -- The symmetric difference of self and `s', modifies self.
  322.       -- Self may be void.
  323.       r::=self;
  324.       loop e::=s.elt!;
  325.      if r.test(e) then r:=r.delete(e)
  326.      else r:=r.insert(e) end end;
  327.       return r end;
  328.     
  329.    sym_difference(s:SAME):SAME is
  330.       -- A new set which is the symmetric difference between self 
  331.       -- and `s'. Self may be void.
  332.       r:SAME;
  333.       loop e::=elt!; 
  334.      if ~s.test(e) then r:=r.insert(e) end end;
  335.       loop e::=s.elt!; 
  336.      if ~test(e) then r:=r.insert(e) end end;
  337.       return r end;
  338.     
  339.    map(m:ROUT{T}:T):SAME is
  340.       -- A new set whose elements are `m' applied to those of self.
  341.       -- Self may be void.
  342.       r:SAME; loop r:=r.insert(m.call(elt!)) end; return r end;
  343.     
  344.    filter(t:ROUT{T}:BOOL):SAME is
  345.       -- A new set whose elements are those of self which satisfy `t'.
  346.       -- Self may be void.
  347.       r:SAME;
  348.       loop e::=elt!; if t.call(e) then r:=r.insert(e) end end; 
  349.       return r end;
  350.  
  351.  
  352.    -- The following routines are provided for conformance with
  353.    -- $RO_SET{T}, and are similar to (but have slightly different
  354.    -- names from) other routines that FSET provides directly
  355.  
  356.    union(s: SAME): SAME is
  357.       -- This is the only one that conflicts with the old FSET
  358.       -- naming scheme.
  359.       -- Old union function:union(s:SAME):SAME is return copy.to_union(s) end;
  360.       return copy.to_union(s) 
  361.    end;
  362.  
  363.    some(t:ROUT{T}:BOOL):BOOL is
  364.       -- True if some element of self satisfies `t'.
  365.       -- Self may be void.
  366.       loop if t.call(elt!) then return true end end;
  367.       return false end;
  368.  
  369.    every(t:ROUT{T}:BOOL):BOOL is
  370.       -- True if every element of self satisfies `t'.
  371.       -- Self may be void.
  372.       loop if ~t.call(elt!) then return false end end;
  373.       return true end;
  374.  
  375.    notany(t:ROUT{T}:BOOL):BOOL is
  376.       -- True if none of the elements of self satisfies `t'.
  377.       -- Self may be void.
  378.       loop if t.call(elt!) then return false end end;
  379.       return true end;
  380.     
  381.    notevery(t:ROUT{T}:BOOL):BOOL is
  382.       -- True if not every element of self satisfies `t'.
  383.       -- Self may be void.
  384.       loop if ~t.call(elt!) then return true end end;
  385.       return false end;
  386.  
  387.    as_array: ARRAY{T} is
  388.       res ::= #ARRAY{T}(size);
  389.       loop res.set!(elt!) end;
  390.       return res;
  391.    end;
  392.  
  393.    str: STR is
  394.       -- Prints out a string version of the array of the components 
  395.       -- that are under $STR
  396.       res ::= #FSTR("{");
  397.       loop  e ::= elt!;
  398.      typecase e
  399.      when $STR then res := res+",".separate!(e.str); 
  400.      else res := res+",".separate!("unprintable"); end;
  401.       end;
  402.       res := res + "}";
  403.       return(res.str);
  404.    end;
  405.     
  406. end -- class FSET{T}
  407.  
  408. -------------------------------------------------------------------
  409.